home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 1.iso
/
ARGONET
/
PD
/
MODULES
/
CSDVAR.ZIP
/
CSDVar.s
(
.txt
)
< prev
next >
Wrap
RISC OS BBC BASIC V Source
|
1997-10-25
|
59KB
|
1,630 lines
>CSDVar/s
$+" / "+
"BasAsmLib"
init_os_dict_tokenise
SHOWREGS_USED = 0
Obufsize%=512 :
buffer size for reading CSD name (+128 for workspace)
Eelipsis$="
" :
default string to use when clipping strings
7elipsis_len%=40 :
default elipsis cut off point
Bhtos%=0:htcs%=0 :
used to see how much FNosd has saved us!
Gscratch_offset% = 128 :
scratch workspace into module workspace
Dcsdvarlen_offset% = 0 :
max length of CSD$Var into workspace
Kdirstack_head% = 4 :
offset of ->head of directory stack (queue)
Kdirstack_tail% = 8 :
offset of ->tail of directory stack (queue)
Delipsis_offset% = 12 :
offset of elipsis string for CSD$Var
=max_elipsis_len% = (scratch_offset%-elipsis_offset%) - 2
Fstackentry_size% = 12 :
size of a stack entry descriptor block
Gstackentry_name% = 0 :
offset of name pointer in a stack entry
8stackentry_next% = 4 :
offset of 'next' pointer
8stackentry_prev% = 8 :
offset of 'prev' pointer
swichunk%=&cd000+64*3
VFlag%=1<<28
code% &4000
pass%=4
"Assembling, Pass ";(pass%
2 + 1;" ... ";
P%=0:O%=code%
[OPT pass%
.moduleheader
&C.startcode EQUD 0 \ We are a service module only
'$.initcode EQUD initialise
(".finalisecode EQUD finalise
.servicehandler EQUD 0
*%.titleofset EQUD titlestring
+$.helpofset EQUD helpstring
,#.tableofset EQUD commtable
-#.swichunk EQUD swichunk%
.$.swihandlerofset EQUD swihandler
/(.swidectabofset EQUD swidecodetable
.swidecodeofset EQUD 0
.titlestring
EQUS "CSDVar":equb 0
.helpstring
5;EQUS "CSDVar":EQUB 9:equb 9:EQUS "2.13 ("+
$,5,11)+")"
6 equs "
Musus Umbra":equb 0
.swidecodetable
9+EQUS "CSDVar":dcb 0 \ SWI prefix
:=equs "Read":dcb 0 \ Read the CSD's full pathname
;<equs "MaxLen":dcb 0 \ Set max length of <CSD$Var>
<.equs "Clip":dcb 0 \ clip a string
=2equs "StackInfo":dcb 0 \ Get info on stack
>7equs "StackControl":dcb 0 \ Misc. stack operations
?@equs "PushDir":dcb 0 \ push a directory onto the stack
@?equs "PopDir":dcb 0 \ pop a directory from the stack
ABequs "UnstackDir":dcb 0 \ remove a directory from the stack
B<equs "UnstackAll":dcb 0 \ deallocate the entire stack
C4equs "Canonicalise":dcb 0 \ canonicalise a path
DRequs "FreeBlock":dcb 0 \ free a block claimed with OS_Module 6 (eg. above)
EQequs "AddToPath":dcb 0 \ intelligently add a directory to a path variable
F<equs "ExistsInPath":dcb 0 \ does a dir exist in a path?
G1equs "GSTrans":dcb 0 \ GSTrans a string
H equs "MakeArgV":dcb 0 \
equs "FreeArgV":dcb 0
JCequs "Debug1":dcb 0 \ print R0 in hex with a preceding &
EQUB 0:ALIGN
M5.swihandler \ code taken straigt from the PRM!
N.CMP R11,#(EndOfJumpTable-JumpTable)/4
ADDLO PC,PC,R11,LSL#2
B unknownswierror
.JumpTable
B read_pwd_swi
B set_max_len_swi
B clip_length_swi
B dir_stack_info_swi
B dir_stack_ctrl_swi
B pushdir_swi
B popdir_swi
B unstack_dir_swi
B unstack_all_swi
B canonicalise
B freeblock
B add_to_path_swi
B exists_in_path
B gs_trans
B swi_make_argv
B swi_free_argv
B print_address
.EndOfJumpTable
.unknownswierror
ADR R0,errtoken
MOV R1,#0
MOV R2,#0
adr (4,titlestring)
j2STMFD R13!,{R14} \ DAMN THAT PRM!
k(SWI "XMessageTrans_ErrorLookup"
l8LDMFD R13!,{R14} \ Bugger Bugger Bugger
RS PC,R14,#VFlag%
.errtoken
o'EQUD &1E6:EQUS "BadSWI":EQUB0:ALIGN
.initialise
STMFD R13!,{R7-R11,R14}
s/LDR R2,[R12] \ get !private word
t0CMP R2,#0 \ is this a re-init?
bne reinit
v:MOV R0,#6 \ OS_Module6 = Claim workspace
w;MOV R3,#bufsize% \ We want 512 bytes (overkill!)
x(SWI "XOS_Module" \ do the swi
ldmvsfd r13!,{r7-r11,pc}
zESTR R2,[R12] \ store workspace pointer in private word
mov r0,#elipsis_len%
|&str r0,[r2,#csdvarlen_offset%]
}#add r12,r2,#elipsis_offset%
adr (0,defelips)
.cpy_def_el
ldrb r1,[r0],#1
strb r1,[r12],#1
cmp r1,#31
bgt cpy_def_el
mov r11,#0
$str r11,[r2,#dirstack_head%]
$str r11,[r2,#dirstack_tail%]
ldrb r1,[r10]
2cmp r1,#32 \ did we have any arguments?
(mov r12,r2 \ module workspace
mov r1,r10
blgt setvariablevalue_ini
ldmvsfd r13!,{r7-r11,pc}
.reinit
bl setvariable
ldmfd r13!,{r7-r11,pc}
.gs_trans
\ On entry:
$\ r0 -> string to GStrans
\ On exit:
F\ r0 = OS_Module 6 claimed buffer conating GSTrans'd string
\ (or error)
stmfd r13!,{r1-r5,r14}
mov r4,r0
mov r0,#6
>mov r3,#64 \ start by trying for <64 bytes
&swi "XOS_Module" \ claim
,mov r5,r2 \ r5 = buffer
ldmvsfd r13!,{r1-r5,pc}
.gs_trans_loop
2mov r0,r4 \ string to GStrans
'mov r1,r5 \ buffer
,mov r2,r3 \ buffer size
swi "XOS_GSTrans"
bvs gstrans_error
movcc r0,r1
3ldmccfd r13!,{r1-r5,pc}^ \ exit if successful
mov r0,#13
mov r2,r5
mov r5,r3
6mov r3,#32 \ try for 32 bytes more
-swi "XOS_Module" \ extend block
Kadd r3,r5,r3 \ add the extension size onto the block size
3movvc r5,r2 \ r5 = -> new buffer
bvc gs_trans_loop
.gstrans_error
mov r1,r0
mov r0,#7
mov r2,r5
,swi "XOS_Module" \ free buffer
blvs ie_nf
mov r0,r1
ldmfd r13!,{r1-r5,r14}
orrs pc,r14,#1<<28
.exists_in_path
\ On entry:
/\ r0 -> path variable, as <foo$path>
@\ r1 -> directory name (with or without trailing '.')
\ On exit:
,\ r3 = 0=>not present, 1=>present
#\ (if error, r1 corrupt)
stmfd r13!,{r1-r5,r14}
2mov r10,r0 \ preserve original
2mov r11,r1 \ preserve original
:bl gs_trans \ GSTrans the path variable
+ldmvsfd r13!,{r1-r5,pc} \ trap error
debpp ("Path var GSTrans'd to -",0)
9mov r1,r0 \ r1 ->GSTrans'd path name
5mov r0,r11 \ r0 -> directory name
+bl gs_trans \ GSTrans it
bvc check_exists_1 \
bl ie_nf
mov r10,r0
mov r0,r1
bl freeblock
blvs ie_nf
mov r0,r10
ldmfd r13!,{r1-r5,r14}
orrs pc,r14,#1<<28
.check_exists_1
\ At this point,
+\ r0 -> GSTrans'd directory name
*\ r1 -> GSTrans'd path variable
%\ r10,r11 = original r0,r1
debpp ("Dir name GSTrans'd to -",0)
mov r11,r0
stmfd r13!,{r0,r1}
sub r1,r1,#1
.chex_loop_1
debpp ("Hunting for non-space, non-comma in -",1)
mov r0,r11
.chex_hunt_non_space
.ldrb r3,[r1,#1]! \ get next char
cmp r3,#
5cmpne r3,#32 \ terminator or space?
beq chex_hunt_non_space
blt chex_done
mov r2,r1
debpp ("Hunting for space, terminator or comma) in -",1)
.chex_hunt_space
ldrb r3,[r2,#1]!
cmp r3,#
cmpne r3,#32
bgt chex_hunt_space
.chex_found_term
cmp r3,#32
9movge r3,#0 \ term with 0 if not final
2movlt r3,#13 \ else term with 13
/strb r3,[r2] \ terminate here
\ Okay, so at this point:
%\ r0 -> GSTrans'd dir name
2\ r1 -> null terminated element of path
&bl lowcmp \ same?
:mov r1,r2 \ start at end of this word
cmp r0,#0
'beq chex_done \ yipee!
/cmp r3,#13 \ out of string?
bne chex_loop_1
.chex_done
debug ("Chex done-")
C\ At this point, buffer ptrs are on stack, r0==0 => match found
cmp r0,#0
movne r12,#0
moveq r12,#1
ldmfd r13!,{r0,r1}
bl freeblock
blvs ie_nf
mov r0,r1
bl freeblock
blvs ie_nf
ldmfd r13!,{r1-r5,r14}
mov r0,r10
mov r3,r12
debug ("Exit chex-")
movs pc,r14
.add_to_path_swi
\ On entry:
=\ r0 -> name of path var as foo, foo$path, or foo:
+\ r1 -> name of directory to add
,\ r2 = 1 (prepend), or 0 (append)
\ On exit:
\ r0 corrupt
stmfd r13!,{r1-r5,r14}
stmfd r13!,{r2}
mov r10,r0
7ldr r12,[r12] \ get workspace
!<add r12,r12,#scratch_offset% \ r12->scratch space
mov r5,r12
mov r11,#
strb r11,[r12]
.atp_cpy_pth
ldrb r11,[r0],#1
strb r11,[r12,#1]!
cmp r11,#
cmpne r11,#
cmpne r11,#
bgt atp_cpy_pth
mov r11,#
adr (11,stringpath) \ ->"$path>\0"
.atp_cpy_trm
ldrb r3,[r11],#1
strb r3,[r12],#1
cmp r3,#0
bne atp_cpy_trm
mov r0,r5
mov r12,r5
5$swi
my_swi("ExistsInPath")
ldmfd r13!,{r2}
ldmvsfd r13!,{r1-r5,pc}
8(cmp r3,#1 \ exists?
9,moveq r0,r10 \ preserve r0
ldmeqfd r13!,{r1-r5,pc}^
\ At this point:
=1\ r0,5,12 -> "<foo$path>" in workspace
>%\ r1 -> name of dir to add
?#\ r2 = pre/app end flag
\ r10 = original r0
A9mov r0,r1 \ r0 -> name of dir to add
B+bl gs_trans \ GSTrans it
CBbl ispath \ check for trailing '.' and colons
D4bl freeblock \ and free the buffer
mov r11,r12
mov r5,r2
G/mov r0,r12 \ r0-><foo$path>
H8bl gs_trans \ gs trans the <foo$path>
I<mov r2,r0 \ r2 -> gs_trans'd <foo$path>
J9mov r0,r1 \ r0 -> name of dir to add
bl strlen
L3add r3,r0,#3 \ +3 for ",." and \0
MDcmp r4,#0 \ does the addition need a '.' added?
NMsubne r3,r3,#1 \ if not, then we don't need the space for it!
mov r0,#13
swi "XOS_Module"
bvc atp_gowi
mov r10,r0
mov r0,#7
swi "XOS_Module"
blvs ie_nf
mov r0,r10
ldmfd r13!,{r1-r5,r14}
orrs pc,r14,#1<<28
.atp_gowi
\ At this point:
[-\ r12 -> "<foo$path>" in workspace
\%\ r1 -> name of dir to add
]8\ r2 = buffer containing GSTrans'd <foo$path>
^3\ r3 = length of $r1 + 3 (or +2 if r4=0)
_"\ r4 = needs a '.' flag
`#\ r5 = pre/app end flag
\ r10 = original r0
cmp r5,#0 \ append?
beq atp_append
.atp_prepend
\ At this point:
g-\ r12 -> "<foo$path>" in workspace
h%\ r1 -> name of dir to add
i8\ r2 = buffer containing GSTrans'd <foo$path>
j3\ r3 = length of $r1 + 3 (or +2 of r4=0)
k"\ r4 = needs a '.' flag
\ r10 = original r0
m6mov r5,r4 \ r5 = 'add a dot' flag
mov r0,r2
oDbl strlen \ r0 = length of GSTrans'd <foo$path>
cmp r0,#0
qGbeq atp_append \ prepend => append if <foo$path> is ""!
r>add r11,r0,r2 \ r11 -> terminator of -- "" --
s=add r4,r11,r3 \ r4 -> byte to relocate to +1
.atp_pre_loop
u)ldrb r0,[r11],#-1 \ get byte
v strb r0,[r4,#-1]! \
w*cmp r11,r2 \ done yet?
bge atp_pre_loop
mov r4,r2
.atp_pre_cpy_dir
ldrb r0,[r1],#1
strb r0,[r4],#1
cmp r0,#32
bgt atp_pre_cpy_dir
mov r0,#
cmp r5,#1
streqb r0,[r4,#-1]
subne r4,r4,#1
mov r0,#
strb r0,[r4]
b atp_setvar
.atp_append
\ At this point:
-\ r12 -> "<foo$path>" in workspace
%\ r1 -> name of dir to add
8\ r2 = buffer containing GSTrans'd <foo$path>
3\ r3 = length of $r1 + 3 (or +2 of r4=0)
"\ r4 = needs a '.' flag
\ r10 = original r0
6mov r5,r4 \ r5 = 'add a dot' flag
mov r0,r2
bl strlen
Aadd r4,r2,r0 \ r4 -> byte to start appending at
cmp r0,#0
Kmov r0,#
"," \ was movne - ie. new path rather than append
Dstrb r0,[r4],#1 \ was strneb - to an empty path. Um.
.atp_app_cpy_dir
ldrb r0,[r1],#1
strb r0,[r4],#1
cmp r0,#32
bgt atp_app_cpy_dir
mov r0,#
cmp r5,#1
streqb r0,[r4,#-1]
subne r4,r4,#1
mov r0,#0
strb r0,[r4]
.atp_setvar
\ At this point:
-\ r12 -> "<foo$path>" in workspace
9\ r2 = buffer containing new value of variable
\ r10 = original r0
mov r5,r2
mov r0,r2
bl strlen
mov r2,r0
6add r12,r12,#1 \ skip '<' in workspace
mov r11,r12
.find_close_angle
ldrb r3,[r11],#1
cmp r3,#
bne find_close_angle
mov r3,#0
4strb r3,[r11,#-1] \ replace '>' with \0
mov r0,r12
mov r1,r5
mov r3,#0
+bl getvartype \ sets up R4
\mov r4,#4
swi "XOS_SetVarVal"
movvc r0,#0
mov r11,r0
mov r0,r5
bl freeblock
blvs ie_nf
mov r0,r11
ldmfd r13!,{r1-r5,r14}
cmp r0,#0
moveq r0,r10
orrne r14,r14,#1<<28
movs pc,r14
.ispath
\ On entry, r1->name
L\ On exit, r4 is path flag; 1=>needs a '.' appending, 0=>is a path as is
stmfd r13!,{r0-r1,r14}
mov r0,r1
bl strlen
1add r0,r0,r1 \ r0 -> terminator
mov r4,#1
.ip_sbl
.ldrb r1,[r0,#-1]! \ get prev char
#cmp r1,#
"." \ dot?
%cmpne r1,#
":" \ colon?
moveq r4,#0
2cmp r1,#32 \ found a char yet?
beq ip_sbl
%ldmfd r13!,{r0-r1,pc}^ \ bye!
.getvartype
\ On entry, r0->var name
\ On exit, r4 = var type
stmfd r13!,{r0-r3,r14}
mov r1,#0
mov r2,#1<<31
mov r3,#0
mov r4,#0
swi "XOS_ReadVarVal"
%cmp r2,#0 \ non existent?
.moveq r4,#0 \ treat as simple string
ldmfd r13!,{r0-r3,pc}^
.dir_stack_info_swi
\ On entry -
\ On exit:
E\ r0 = address of 'head' (top) entry (or NULL if no stack)
H\ r1 = address of 'tail' (bottom) entry (of NULL if no stack)
\ r2 = stack entries
%\ r3 = bytes used by stack
?ldr r12,[r12] \ get workspace pointer
stmfd r13!,{r4,r14}
9ldr r4,[r12,#dirstack_head%] \ pointer to head
9ldr r1,[r12,#dirstack_tail%] \ pointer to tail
6mov r2,#0 \ init counter
9mov r3,#0 \ init bytes used
$cmp r4,#0 \ stack empty?
beq dsis_done
.dsis_loop
Dadd r3,r3,#stackentry_size% \ size += sizeof(stackentry)
4add r2,r2,#1 \ counter ++
&ldr r0,[r4,#stackentry_name%]
bl strlen
Fadd r0,r0,#1 \ include the NULL terminator!
Fadd r3,r3,r0 \ size += strlen(scan->name)+1
=ldr r4,[r4,#stackentry_prev%] \ scan = scan -> prev
Bcmp r4,#0 \ scan = 0 (ie. finished)?
8bne dsis_loop \ until scan = 0
.dsis_done
9ldr r0,[r12,#dirstack_head%] \ pointer to head
/ldmfd r13!,{r4,pc}^ \ byee!
.strlen
\ On entry, r0 -> string
$\ On exit, r0 = length of string
stmfd r13!,{r1,r2}
sub r1,r0,#1
.strlen_1
ldrb r2,[r1,#1]!
cmp r2,#32
bge strlen_1
sub r0,r1,r0
ldmfd r13!,{r1,r2}
movs pc,r14
.is_in_RMA
\ Internal use
\ On entry:
\ r0 = address
\ On exit:
H\ r0 preserved if address is in RMA, errptr & V set otherwise
stmfd r13!,{r1-r3,r14}
1mov r3,r0 \ copy the address
$mov r0,#1 \ RMA
"swi "XOS_ReadDynamicArea"
=cmp r0,r3 \ is address >= start of area?
&blt not_in_RMA \ oops!
4add r0,r0,r1 \ end address of area
;cmp r0,r3 \ is address <= end of area?
&blt not_in_RMA \ oops!
mov r0,r3
ldmfd r13!,{r1-r3,pc}^
.not_in_RMA
adr (0,nirma_eblk)
ldmfd r13!,{r1-r3,r14}
orrs pc,r14,#1<<28
.dir_stack_ctrl_swi
\ On entry:
&D\ r0 = address of new 'head' (top) [must be in RMA], or 0
'G\ r1 = address of new 'tail' (bottom) [must be in RMA], or 0
\ On exit:
\ All regs preserved
stmfd r13!,{r2,r14}
+6ldr r12,[r12] \ get workspace pointer
,.cmp r0,#0 \ is new head 0
-1cmpne r1,#0 \ or is the tail 0
.(moveq r2,r0 \ (dufge)
/?beq store_new_ends \ skip 'in RMA' check and update
0Fbl is_in_RMA \ test to see if it's in the RMA or not
19ldmvsfd r13!,{r2,pc} \ return error if it isn't
mov r2,r0
mov r0,r1
4Fbl is_in_RMA \ test to see if it's in the RMA or not
59ldmvsfd r13!,{r2,pc} \ return error if it isn't
.store_new_ends
7%str r0,[r12,#dirstack_tail%]
8%str r2,[r12,#dirstack_head%]
ldmfd r13!,{r2,pc}^
.pushdir_swi
\ On entry:
=<\ r0 -> directory name to push (or 0 to push CSD)
\ On exit:
?/\ r0 preserved or error ptr if V set
ldr r12,[r12]
stmfd r13!,{r1-r5,r14}
B5mov r5,r0 \ preserve original r0
C%cmp r0,#0 \ CSD?
adrc ("eq",0,pathname) \ ->"@"
EJbl canonicalise \ canonicalise the path (new address in r0)
F-ldmvsfd r13!,{r1-r5,pc} \ catch errors
G>mov r4,r0 \ preserve -> canonicalise name
H&mov r0,#6 \ claim
IJmov r3,#stackentry_size% \ size of a stack entry descriptor
J0swi "XOS_Module" \ claim workspace
K6bvc pushdir_swi_1 \ if succeded, carry on
L7mov r5,r0 \ preserve error pointer
M5mov r0,r4 \ -> canonicalise name
N-bl freeblock \ free storage
blvs ie_nf
P6mov r0,r5 \ restore error pointer
Q.ldmfd r13!,{r1-r5,r14} \ and registers
R4orrs pc,r14,#1<<28 \ and exit with error
SO.pushdir_swi_1 \ r2->stack entry, r4->canon name, r5->orig name
T:ldr r0,[r12,#dirstack_head%] \ get top of stack
UGstr r4,[r2,#stackentry_name%] \ newnode->name = canon'd name;
mov r4,#0
W?str r4,[r2,#stackentry_next%] \ newnode->next = NULL;
X?str r0,[r2,#stackentry_prev%] \ newnode->prev = head;
Y5cmp r0,#0 \ if ( head )
ZBstrne r2,[r0,#stackentry_next%] \ head->next = newnode;
[:mov r0,r2 \ head = newnode;
\Imoveq r1,r2 \ if (!head) tail = newnode;
]Istr r0,[r12,#dirstack_head%] \ store new head (always altered)
^Astreq r1,[r12,#dirstack_tail%] \ store tail (if altered)
_2ldmfd r13!,{r1-r5,pc}^ \ and exit
.popdir_swi
\ On entry -
d@\ On exit - (r0 possibly an error ptr, else ->new CSD name)
e;ldr r12,[r12] \ get workspace ptr
f4stmfd r13!,{r1-r3,r14} \ stack regs
g6ldr r2,[r12,#dirstack_head%] \ get head ptr
h0cmp r2,#0 \ zero ?
i@ldmeqfd r13!,{r1-r3,pc}^ \ no stack! exit quietly
j8ldr r1,[r2,#stackentry_name%] \ get ->dir name
k1mov r0,#0 \ set CSD
l/swi "XOS_FSControl" \ do it
m5movvc r0,#0 \ if no error
stmfd r13!,{r0}
oAldr r3,[r2,#stackentry_prev%] \ get -> previous entry
p6mov r0,r2 \ -> head node
q4bl freeblock \ deallocate
blvs ie_nf
s8mov r0,r1 \ -> name buffer
t4bl freeblock \ deallocate
blvs ie_nf
v8str r3,[r12,#dirstack_head%] \ store new head
w,cmp r3,#0 \ 0?
x8streq r3,[r12,#dirstack_tail%] \ store new head
yEldmfd r13!,{r0} \ get that (maybe) error back
z:cmp r0,#0 \ was it an error?
{2swieq
my_swi("Read") \ fudge Ho!
|)ldmfd r13!,{r1-r3,r14} \
moveq pc,r14
~0orrs pc,r14,#1<<28 \ splat!
.canonicalise
(\ On entry, r0 -> pathname of object
H\ On exit, r0 -> canonicalised path (block claimed with OS_Module 6)
$\ (or error pointer if V set)
stmfd r13!,{r1-r5,r14}
#mov r1,r0 \ ->pathname
*mov r0,#37 \ Canocicalise path
!mov r2,#0 \ ->buffer
Kmov r3,#0 \ I think I'm gonna cry. Next time I check the PRMs
Lmov r4,#0 \ *before* !StrongHlp (which didn't mention this bit)
$mov r5,#0 \ buffer size
swi "XOS_FSControl"
bvc canonicalise_1
ldmfd r13!,{r1-r5,r14}
/orrs pc,r14,#1<<28 \ exit with error
.canonicalise_1
>rsb r3,r5,#1 \ r3 = 1-r5, ie. number of bytes needed
mov r0,#6
swi "XOS_Module"
bvc canonicalise_2
ldmfd r13!,{r1-r5,r14}
/orrs pc,r14,#1<<28 \ exit with error
.canonicalise_2
mov r0,#37
mov r5,r3
Kmov r3,#0 \ I think I'm gonna cry. Next time I check the PRMs
Lmov r4,#0 \ *before* !StrongHlp (which didn't mention this bit)
swi "XOS_FSControl"
mov r0,r2
ldmfd r13!,{r1-r5,pc}^
.freeblock
=\ On entry, r0->block previously returned by canonicalise
2\ On exit, r0 corrupt or error pointer (V set)
stmfd r13!,{r2,r14}
mov r2,r0
mov r0,#7
swi "XOS_Module"
ldmfd r13!,{r2,pc}
.unstack_all_swi
\ On entry:
\ -
\ On exit:
)\ - (r0 possibly error, V set)
stmfd r13!,{r1-r4,r14}
mov r10,r0
Iswi
my_swi("StackInfo") \ get head, tail, entries and size
ldmvsfd r13!,{r1-r4,pc}
0cmp r2,#0 \ is stack empty?
moveq r0,r10
6ldmeqfd r13!,{r1-r4,pc}^ \ if so, nothing to do!
,mov r1,r0 \ r1 = ->head
.ua_free_loop
subs r2,r2,#1
4bmi adnyerr2 \ Ooops... 4am error!
4ldr r0,[r1,#stackentry_name%] \ scan->name
bl freeblock
blvs ie_nf
mov r0,r1
&ldr r1,[r1,#stackentry_prev%]
bl freeblock
blvs ie_nf
3cmp r1,#0 \ done yet?
bne ua_free_loop
3mov r0,r1 \ r0,r1 = 0
$swi
my_swi("StackControl")
movvc r0,r10
ldmfd r13!,{r1-r4,pc}
.adnyerr2
ldmfd r13!,{r1-r4,r14}
adr (0,stack_what_stack)
orrs pc,r14,#1<<28
.unstack_dir_swi
\ On entry:
=\ r0 -> dir name to unstack (or 0 => top of stack)
\ On exit:
-\ r0 preserved (or error if V set)
stmfd r13!,{r1-r4,r14}
mov r10,r0
cmp r0,#0
blne canonicalise \
6ldmvsfd r13!,{r1-r4,pc} \ catch any errors here
Cmov r4,r0 \ r4 -> canonicalised name to remove
Fswi
my_swi("StackInfo") \ get head, tail, entries, size
+mov r3,r0 \ r3 -> head
3mov r1,r4 \ r1 -> name to find
-cmp r2,#0 \ stack empty?
6bne uds_find_entry \ if not, find and kill
mov r0,r4
cmp r0,#0
,blne freeblock \ free buffer
+mov r0,r10 \ restore r0
0ldmfd r13!,{r1-r4,pc}^ \ exit (no error)
.uds_find_entry
mov r1,r4
0cmp r1,#0 \ remove top dir?
4beq found_match \ don't do the search
.uds_search
6ldr r0,[r3,#stackentry_name%] \ get name ptr
@bl lowcmp \ same as search string?
2cmp r0,#0 \ matched?
)beq found_match \
&ldr r3,[r3,#stackentry_prev%]
cmp r3,#0
bne uds_search
mov r0,r1
bl freeblock
mov r0,r10
;ldmfd r13!,{r1-r4,pc}^ \ not an error if not found!
.found_match
mov r0,r1
cmp r0,#0
blne freeblock
9ldr r0,[r3,#stackentry_prev%] \ r0 = this->prev
9ldr r2,[r3,#stackentry_next%] \ r2 = this->next
Gstmfd r13!,{r0,r2} \ stack this->prev & this->next
9cmp r0,#0 \ if (this->prev)
Jstrne r2,[r0,#stackentry_next%] \ this->prev->next = this->next
9cmp r2,#0 \ if (this->next)
Jstrne r0,[r2,#stackentry_prev%] \ this->next->prev = this->prev
&ldr r0,[r3,#stackentry_name%]
bl freeblock
mov r0,r3
bl freeblock
ldr r12,[r12]
%ldr r0,[r12,#dirstack_head%]
%ldr r1,[r12,#dirstack_tail%]
Jldmfd r13!,{r2,r4} \ r2 = this->prev, r4 = this->next
8cmp r0,r3 \ if head = this
>streq r2,[r12,#dirstack_head%] \ head = this->prev
8cmp r1,r3 \ if tail = this
>streq r4,[r12,#dirstack_tail%] \ tail = this->next
mov r0,r10
;ldmfd r13!,{r1-r4,pc}^ \ not an error if not found!
.tolower
\ On entry, r3 = character
(\ On exit, r3 = lowercase equivalent
cmp r3,#31
movle r3,#0
cmp r3,#
movlts pc,r14
cmp r3,#
addle r3,r3,#32
movs pc,r14
.lowcmp
\ On entry:
\ r0 ->string 1
\ r1 ->string 2
\ On exit:
F\ r0 = character at which strings differ, or 0 if identical
stmfd r13!,{r2-r4,r14}
mov r2,#0
.lowcmp_loop
ldrb r3,[r0,r2]
bl tolower
mov r4,r3
ldrb r3,[r1,r2]
bl tolower
add r2,r2,#1
cmp r4,#0
ble lowcmp_fs
cmp r4,r3
beq lowcmp_loop
mov r0,r2
ldmfd r13!,{r2-r4,pc}^
.lowcmp_fs
mov r0,#0
ldmfd r13!,{r2-r4,pc}^
.read_pwd_swi
stmfd r13!,{r14}
ldr r0,[r12]
7Jadd r0,r0,#scratch_offset% \ v1.20; SKIP OVER OUR WORKSPACE
bl read_pwd
ldmfd r13!,{pc}^
stmfd r13!,{r0-r1,r14}
=.ldr r0,[r12] \ get ->workspace
>Jadd r0,r0,#scratch_offset% \ v1.20; skip over our workspace
?'bl read_pwd \ read CSD
@+swi "XOS_Write0" \ write string
A!swi "XOS_NewLine" \ LF
B#ldmfd r13!,{r0-r1,pc}^ \ exit
.read_pwd
stmfd r13!,{r2-r5,r14}
F!mov r2,r0 \ buffer
mov r0,#37 \
adr (1,pathname) \ pathname
mov r3,#0
mov r4,#0
KKmov r5,#bufsize% \ buffer size can now be changed more easily
LGsub r5,r5,#scratch_offset% \ scratch_offset% bytes not available
swi "XOS_FSControl"
bvs fsc_error
cmp r5,#0
ble buffertoosmall
QOadd r5,r5,#scratch_offset%\ fudge the bytes free value to account for WS
R(rsb r5,r5,#bufsize% \ var length
S .exit
T%mov r1,r5 \ var length
U!mov r0,r2 \ buffer
ldmfd r13!,{r2-r5,pc}^
.buffertoosmall
adr (0,btsmlm)
.fsc_error
add r0,r0,#4
mov r1,#0
.copyerror
ldrb r3,[r0,r1]
strb r3,[r2,r1]
add r1,r1,#1
cmp r3,#31
bgt copyerror
b)subs r5,r1,#1 \ string length
b exit
.setvariable
stmfd r13!,{r0-r4,r14}
adr (0,variablename)
adr (1,variablecode)
i/mov r2,#(endofvariablecode-variablecode)
mov r3,#0
mov r4,#16
swi "XOS_SetVarVal"
ldmvsfd r13!,{r0-r4,pc}
adr (0,variable2_name)
adr (1,variable2_code)
p2mov r2,#(end_variable2_code-variable2_code)
mov r3,#0
mov r4,#16
swi "XOS_SetVarVal"
ldmfd r13!,{r0-r4,pc}
.unsetvariable
stmfd r13!,{r0-r4,r14}
adr (0,variablename)
adr (1,variablecode)
mvn r2,#1
mov r3,#0
mov r4,#16
swi "XOS_SetVarVal"
adr (0,variable2_name)
adr (1,variable2_code)
mvn r2,#1
mov r3,#0
mov r4,#16
swi "XOS_SetVarVal"
ldmfd r13!,{r0-r4,pc}
..setvariablevalue_ini \ Mung Ho!
\ On entry:
!\ r1 -> (string) value
+\ r2 = length of value (ignored)
\ r12 = workspace
stmfd r13!,{r0,r14}
Pmov r0,#1<<31 \ must terminate with ctrl or space, default base
2swi "XOS_ReadUnsigned"\ convert to number
&ldmvsfd r13!,{r1,pc} \ oops?
7mov r0,r2 \ value (r1->terminator)
3mov r4,r1 \ r4 = -> terminator
E\swi
my_swi("MaxLen")\ can't use our own SWIs in init code!
$add r1,r12,#elipsis_offset%
(str r0,[r12,#csdvarlen_offset%]
<b process_elips_arg \ as normal set variable now
.variable2_code
5movs pc,r14 \ write entry point
4stmfd r13!,{r14} \ read entry point
+swi
my_swi("Read") \ read PWD
5mov r2,r1 \ length (excl. \0)
)ldmfd r13!,{pc}^ \ byee!
.end_variable2_code
.variablecode
2b setmaxlength \ write entry point
1stmfd r13!,{r14} \ read entry point
,swi
my_swi("Read") \ read the PWD
Hmov r1,#0 \ default length (ie. get from workspace)
Imov r2,#0 \ default elipsis (ie. get from workspace)
3swi
my_swi("Clip") \ and clip its length
8sub r2,r1,#1 \ length excl. terminator
ldmfd r13!,{pc}^
?.setmaxlength \ write entry point for variable
\ On entry:
!\ r1 -> (string) value
+\ r2 = length of value (ignored)
4\ On exit, r1,r2,r4,r10,r11,r12 may be corrupted
stmfd r13!,{r0,r14}
Pmov r0,#1<<31 \ must terminate with ctrl or space, default base
2swi "XOS_ReadUnsigned"\ convert to number
&ldmvsfd r13!,{r1,pc} \ oops?
7mov r0,r2 \ value (r1->terminator)
3mov r4,r1 \ r4 = -> terminator
Amov r1,#0 \ => leave elipsis alone (for now)
Nswi
my_swi("MaxLen")\ set length and get the elipsis pointer (in r1)
&ldmvsfd r13!,{r1,pc} \ oops?
.process_elips_arg
@\ Right, r1-> old elipsis, r4->next char in var value string
+\ (original) r0 and LR are on the stack
,.smlcv_skip_spc \ skip spaces
.ldrb r0,[r4],#1 \ get next char
/cmp r0,#32 \ is it a space?
/beq smlcv_skip_spc \ if so, hunt on
Fldmltfd r13!,{r0,pc}^ \ if ctrl, then don't alter the elipsis
L\ Okay, so r4->first real character of elipsis, and r0 is that character
stmfd r13!,{r0,r1,r4}
Qmov r14,#1 \ Kids! Don't muck with the link register at home!
8.parse_or_store \ r14 = 'parse only' flag
9cmp r0,#34 \ is char a '"' character?
=moveq r10,#0 \ clear 'disallow spaces' flag
,movne r10,#1 \ else set it
<subne r4,r4,#1 \ ... move back onto the char
Acmp r0,#
"\" \ was char a '\' (ie. literal quote)
@moveq r11,#1 \ ... if so, set the 'quote' flag
Qaddeq r4,r4,#1 \ ... and undo that move back onto char [Mung Ho!]
@movne r11,#0 \ ... else unset the 'quote' flag
>mov r12,#max_elipsis_len% \ max length of an elipsis
.smlcv_cpy_elipsis
.ldrb r0,[r4],#1 \ get next char
>cmp r14,#0 \ are we doing it for real yet?
Bstreqb r0,[r1],#1 \ if so, store in elipsis workspace
6cmp r0,#31 \ is it the terminator?
3ble smlcv_eoe \ if so, we're done!
Acmp r11,#1 \ is the literal 'quote' flag set?
4moveq r11,#0 \ ... if so, clear it
Tbeq smlcv_cpy_elipsis \ ... and loop around (ie. store the char regardless)
Ecmp r0,#
"\" \ is this char the literal 'quote' char?
Dmoveq r11,#1 \ ...if so, then set the 'quote' flag
Bsubeq r1,r1,#1 \ ... back up onto the (stored) '\'
4beq smlcv_cpy_elipsis \ ... and loop around
/cmp r0,#32 \ is it a space?
7cmpeq r10,#1 \ and are spaces banned?
?beq smlcv_eoe \ if so, treat as the terminator
/cmp r0,#34 \ is it a quote?
Lcmpeq r10,#0 \ and are spaces allowed (ie. quotes aren't)?
?beq smlcv_eoe \ if so, treat as the terminator
:subs r12,r12,#1 \ decrement remaining space
>bgt smlcv_cpy_elipsis \ if spaceleft then loop around
.smlcv_eoe
:cmp r14,#0 \ are we doing it for real?
moveq r11,#0
Sstreqb r11,[r1,#-1] \ if so overwrite last char (prob. term) with a null
)ldmeqfd r13!,{r0,pc}^ \ and bye!
9cmp r12,#0 \ did we run out of space?
ble elipsis_too_long
Mcmp r10,#0 \ I just Lurve ARM assembler! This is so cool!
Dcmpeq r0,#34 \ See the 'neatCmps!' drawfile for an
?cmpne r10,#1 \ explanation of why these work!
Ecmpeq r11,#0 \ (at the end, eq=>valid, ne=>invalid)
bne parse_error \
6cmp r14,#1 \ were we just parsing?
8ldmnefd r13!,{r0,pc}^ \ if not, we're finished!
=ldmfd r13!,{r0,r1,r4} \ if so, restore old registers
:mov r14,#0 \ unset the parse only flag
=b parse_or_store \ and do it for real this time
.elipsis_too_long
Icmp r14,#1 \ call me paranoid, but I'm gonna check it
Gldmeqfd r13!,{r0,r1,r4} \ if just parsing then unstack registers
adr (0,eliptl_err) \ ->error block
+ldmfd r13!,{r1,r14} \ get old LR
4orrs pc,r14,#1<<28 \ and exit with V set
%.parse_error \ oops
Icmp r14,#1 \ call me paranoid, but I'm gonna check it
Gldmeqfd r13!,{r0,r1,r4} \ if just parsing then unstack registers
Qcmp r11,#1 \ did we barf because of an incomplete \ sequence?
adrc ("eq",0,incompipe_err) \ ->error block
adrc ("ne",0,missingq_err)
+ldmfd r13!,{r1,r14} \ get old LR
4orrs pc,r14,#1<<28 \ and exit with V set
.endofvariablecode
.finalise
stmfd r13!,{r14}
bl unsetvariable
cmp r10,#1
5ldmnefd r13!,{pc}^ \ closedown (for the mo).
Ibl unstack_all_swi \ only clear the dir. stack on a fatal death!
0mov r0,#7 \ free the workspace
)ldr r2,[r12] \ ->workspace
$swi "XOS_Module" \ do it.
Bldmfd r13!,{pc}^ \ don't allow errors to stop us dying!
.clip_length_swi
\ On entry:
\ r0->string
!K\ r1=length to clip to (excl. terminator) <=0 means use module's
"5\ r2=elipsis string <=0 means use module's
\ On exit:
$'\ r0->string (ie. preserved)
%7\ r1=new length of string (incl. terminator)
stmfd r13!,{r2-r4,r14}
'0ldr r12,[r12] \ get ->workspace
(Acmp r1,#0 \ is the length actually specified
)Mldrle r1,[r12,#csdvarlen_offset%] \ if not, get default from workspace
*@cmp r2,#0 \ is the elipsis string specified
+Oaddle r2,r12,#elipsis_offset% \ if not, use our string in the workspace
,0mov r3,r1 \ r3 = max length
-5mov r4,r2 \ r4 -> elipsis string
.-mov r2,r0 \ r2 -> string
.cls_strlen
0)ldrb r1,[r2],#1 \ get char
15cmp r1,#31 \ is it the terminator
25bgt cls_strlen \ if not, keep looking
3Fsub r1,r2,r0 \ r1 = string length (incl. terminator)
4Acmp r1,r3 \ check to see if in range already
5Dldmlefd r13!,{r2-r4,pc}^ \ if it is, we can exit straight away
mov r10,#0
7B.clse_strlen \ find length of the elipsis string
8)ldrb r11,[r4,r10] \ get char
95cmp r11,#31 \ is it the terminator
:0addgt r10,r10,#1 \ if not, move on
;7bgt clse_strlen \ and on (length in r10)
<Ccmp r10,r3 \ is elipsis longer than max length?
=:movgt r10,r3 \ if so, clip to max length
>Qsub r3,r3,r10 \ don't forget to allow for the elipsis! (r10=len)
?Cmov r2,r3,lsr#1 \ r2 = number of lefthand characters
@Aadd r1,r0,r2 \ r1 -> first character to replace
ACsub r3,r3,r2 \ r3 = number of righthand charaters
B=sub r2,r1,#1 \ r2 -> character we're at - 1
.cpy_elipsis
D6subs r10,r10,#1 \ while ( (--elen)>=0 )
E ldrgeb r11,[r4],#1 \
F strgeb r11,[r2,#1]! \
G bge cpy_elipsis \
HHadd r1,r2,#1 \ r1-> byte after last char of terminator
.find_term
J.ldrb r12,[r2,#1]! \ get next char
K5cmp r12,#31 \ is it the terminator
L0bgt find_term \ if not, hunt on
M%\ Okay, so now r2->the terminator
NCsub r2,r2,r3 \ r2 -> first char of righthand side
.copy_right
P)ldrb r12,[r2],#1 \ get char
Q&strb r12,[r1],#1 \ store
R6cmp r12,#31 \ is it the terminator?
bgt copy_right
T>sub r1,r1,r0 \ new length (incl. terminator)
U%ldmfd r13!,{r2-r4,pc}^ \ exit
.set_max_len_swi
Y;\ On entry, r0 = new max length, r1->new elipsis string
Z(\ (<=0 implies read but don't alter)
[G\ On exit, r0 = max length in effect, r1->elipsis string in effect
\6ldr r12,[r12] \ get workspace pointer
]5cmp r0,#0 \ is length specified?
^Gldrle r0,[r12,#csdvarlen_offset%] \ if not, then use the current
_:strgt r0,[r12,#csdvarlen_offset%] \store new length
`<cmp r1,#0 \ is there an elipsis string?
aFaddle r1,r12,#elipsis_offset% \ if not, get current elipsis
b+movles pc,r14 \ and return
c%add r12,r12,#elipsis_offset%
d5mov r0,r12 \ elipsis base pointer
eKadd r11,r12,#max_elipsis_len% \ elipsis must be 'n' chars or less
fH.sml_cpy_elipsis \ copy the new elipsis into the workspace
g)ldrb r10,[r1],#1 \ get char
h5cmp r0,r11 \ is elipsis too long?
iFmovge r10,#0 \ force termination if elipsis too long
j)strb r10,[r0],#1 \ store it
k,cmp r10,#31 \ terminator?
l%bgt sml_cpy_elipsis \ loop
m.mov r1,r12 \ ->new elipsis
nRldr r0,[r12,#csdvarlen_offset%-elipsis_offset%] \ get current max len
o%movs pc,r14 \ bye!
r4.pushdir_cmd \ wrapper for the swi
s stmfd r13!,{r1,r14} \
t>ldrb r1,[r0] \ get first char of command tail
u%cmp r1,#31 \ ctrl?
vAmovle r0,#0 \ replace with NULL (ie. implies @)
swi
my_swi("PushDir")
x8ldmfd r13!,{r1,pc} \ exit (with any errors!)
.unpushdir_cmd
{ stmfd r13!,{r1,r14} \
|>ldrb r1,[r0] \ get first char of command tail
}%cmp r1,#31 \ ctrl?
~Mmovle r0,#0 \ replace with NULL (ie. implies top directory)
"swi
my_swi("UnstackDir")
8ldmfd r13!,{r1,pc} \ exit (with any errors!)
;.liststack_cmd \ display the stack contents
0stmfd r13!,{r0-r4,r14} \ stack some regs
adr (0,liststackhead) \ header message
mov r1,#0
mov r2,#0
(swi "XOS_PrettyPrint" \ display
3swi
my_swi("StackInfo") \ get head & tail
.pstack_loop
*cmp r1,#0 \ done yet?
beq pstack_done
:ldr r0,[r1,#stackentry_name%] \ get name pointer
.swi "XOS_Write0" \ print message
#swi "XOS_NewLine" \ NL
1ldr r1,[r1,#stackentry_next%] \ get next
b pstack_loop
.pstack_done
adr (0,scnts)
mov r4,r2
mov r1,#0
mov r2,#0
swi "XOS_PrettyPrint"
ldr r12,[r12]
$add r1,r12,#scratch_offset%
mov r0,r4
+mov r2,#(bufsize%-scratch_offset%)
#swi "XOS_ConvertCardinal2"
swi "XOS_Write0"
adr (0,entries)
mov r1,#0
mov r2,#0
swi "XOS_PrettyPrint"
$add r1,r12,#scratch_offset%
mov r0,r3
+mov r2,#(bufsize%-scratch_offset%)
#swi "XOS_ConvertCardinal4"
swi "XOS_Write0"
adr (0,bytesmess)
mov r1,#0
mov r2,#0
swi "XOS_PrettyPrint"
ldmfd r13!,{r0-r4,pc}^
.swi_make_argv
%\ On entry, r0 = -> command line
\ r13 = stack
\ On exit, r0 = argc
\ r1 = argv
R\ $(argv!0), $(argv!4), ... = argument vector (claimed from the RMA)
+\ (or V set, r0->error block)
stmfd r13!,{r2-r5,r14}
%mov r4,#0 \ argc
5sub r1,r0,#1 \ r1->(command line-1)
(.uia_1 \ find start of next argument
ldrb r2,[r1,#1]!
cmp r2,#32
4beq uia_1 \ skip leading spaces
;blt uia_3 \ if ctrl, we're out of args
'add r4,r4,#1 \ argc++
.uia_2 \ found an argument
ldrb r2,[r1,#1]!
cmp r2,#32
5bgt uia_2 \ find next ctrl/space
Dbeq uia_1 \ if space, look for another argument
.uia_3 \ found terminator
7sub r5,r1,r0 \ length of command line
1add r5,r5,#2 \ +2 for paranoia!
4mov r1,r0 \ r1 = ->command line
Imov r3,r4,lsl#2 \ r3 = argc*4 (ie. #bytes needed for argv)
&mov r0,#6 \ claim
5swi "XOS_Module" \ claim space for argv
Kldmvsfd r13!,{r2-r5,pc} \ if error, restore regs from stack and exit
5stmfd r13!,{r2} \ push argv onto stack
*mov r0,#6 \ paranoia!
7mov r3,r5 \ length of command line
Bswi "XOS_Module" \ claim space for command line copy
Pbvc uia_4 \ if there's an error, the cleanup is a bit messy
4ldmfd r13!,{r2} \ get argv from stack
3mov r4,r0 \ preserve error ptr
%mov r0,#7 \ free
*swi "XOS_Module" \ free argv
2mov r0,r4 \ restore error ptr
-ldmfd r13!,{r2-r5,r14} \ restore regs
4orrs pc,r14,#1<<28 \ and exit with V set
R.uia_4 \ set up argv (argv[0] in r2, argv on stack, r1->command line, r4=argc)
*ldmfd r13!,{r3} \ r3 = argv
>stmfd r13!,{r3,r4} \ push argv and argc onto stack
*.uia_5 \ next argument of command line
.str r2,[r3],#4 \ store argv[i]
!.uia_6 \ find end of argument
;ldrb r5,[r1],#1 \ get char from command line
-cmp r5,#32 \ is it a ctrl
1strgtb r5,[r2],#1 \ store in argv[0]
>bgt uia_6 \ find next non-space, non-ctrl
'subs r4,r4,#1 \ argc--
Bbeq uia_8 \ if argc==0 then out of arguments!
.uia_7 \ skip spaces
>ldrb r5,[r1],#1 \ get next char of command line
/cmp r5,#32 \ is it a space?
4beq uia_7 \ find next non-space
mov r5,#0
>strb r5,[r2],#1 \ replace the space with a NULL
/subgt r1,r1,#1 \ back up a char
Fbgt uia_5 \ if it's not a ctrl, loop around again
T.uia_adny_f_u \ if it *is* a control, then Adny's fucked up (again)
debug("Adny fucked up
Eldmfd r13!,{r3,r4} \ pop argv into r3 (also argc into r4)
Hldr r2,[r3] \ get argv[0] (ie. the command line copy)
%mov r0,#7 \ free
-swi "XOS_Module" \ free argv[0]
mov r2,r3
mov r0,#7
*swi "XOS_Module" \ free argv
adr (0,adnyfu) \ ->error block
-ldmfd r13!,{r2-r5,r14} \ restore regs
4orrs pc,r14,#1<<28 \ and exit with V set
.uia_8 \ out of arguments
mov r0,#0
8strb r0,[r2] \ terminate last argument
2ldmfd r13!,{r1,r2} \ pop argv ard argc
2mov r0,r2 \ return argc in r0
)ldmfd r13!,{r2-r5,pc}^ \ and exit
.swi_free_argv
I\ On entry, r1=argv, on exit all regs preserved (or r0->err if V set)
mov r10,r0 \
3mov r11,r2 \ preserve some regs
!mov r12,r14 \
(ldr r2,[r1] \ argv[0]
)mov r0,#7 \ 7 = free
swi "XOS_Module" \
Hmovvc r2,r1 \ argv (no point if previous free failed)
Dswivc "XOS_Module" \ only try if the free argv[0] worked
=movvc r0,r10 \ only restore r0 if no errors
6mov r2,r11 \ but always restore r2
Fmov pc,r12 \ NB! not movS - want to return errors!
.addtopath_cmd
mov r2,#0
b adpath_common
.prependpath_cmd
mov r2,#1
.adpath_common
stmfd r13!,{r14}
swi
my_swi("MakeArgV")
ldmvsfd r13!,{pc}
\ r0 = argc, r1 = argv
,sub r4,r0,#1 \ r4 = argc-1
*mov r5,r1 \ r5 = argv
4ldr r0,[r1],#4 \ get argv[0], argv++
.process_args
add r6,r1,#4
ldr r1,[r1]
debpp ("Adding directory ",1)
debpp ("to path ",0)
"!swi
my_swi("AddToPath")
bvs atpc_failure
mov r1,r6
subs r4,r4,#1
bgt process_args
mov r1,r5
( swi
my_swi("FreeArgV")
blvs ie_nf
ldmfd r13!,{pc}^
.atpc_failure
mov r1,r5
mov r5,r0
. swi
my_swi("FreeArgV")
blvs ie_nf
mov r0,r5
ldmfd r13!,{r14}
orrs pc,r14,#1<<28
.commtable
9#equs "pwd":dcb 0:align:equd pwd
:) equd &00000:equd 0:equd pwdhelp
<-equs "PushDir":dcb 0:align \ command name
=/equd pushdir_cmd \ offset to code
>*equb &00 \ min parms
?>equb &00 \ GSTrans map for first 8 parms
@*equb &01 \ max parms
A&equb &00 \ flags
BAequd pushdir_syntax \ offset to invalid syntax message
C7equd pushdir_help \ offset to help message
E-equs "PopDir":dcb 0:align \ command name
F/equd popdir_swi \ offset to code
G*equb &00 \ min parms
H>equb &00 \ GSTrans map for first 8 parms
I*equb &00 \ max parms
J&equb &00 \ flags
KAequd popdir_syntax \ offset to invalid syntax message
L7equd popdir_help \ offset to help message
N0equs "UnPushDir":dcb 0:align \ command name
O/equd unpushdir_cmd \ offset to code
P*equb &00 \ min parms
Q>equb &00 \ GSTrans map for first 8 parms
R*equb &01 \ max parms
S&equb &00 \ flags
TAequd unpushdir_syntax \ offset to invalid syntax message
U7equd unpushdir_help \ offset to help message
W0equs "ListStack":dcb 0:align \ command name
X/equd liststack_cmd \ offset to code
Y*equb &00 \ min parms
Z>equb &00 \ GSTrans map for first 8 parms
[*equb &00 \ max parms
\&equb &00 \ flags
]Aequd liststack_syntax \ offset to invalid syntax message
^7equd liststack_help \ offset to help message
`0equs "KillStack":dcb 0:align \ command name
a1equd unstack_all_swi \ offset to code
b*equb &00 \ min parms
c>equb &00 \ GSTrans map for first 8 parms
d*equb &00 \ max parms
e&equb &00 \ flags
fBequd unstackall_syntax \ offset to invalid syntax message
g8equd unstackall_help \ offset to help message
i equs "AddToPath":dcb 0:align
j0equd addtopath_cmd \ offset to code
k-equb &02 \ min parms
lAequb &00 \ GSTrans map for first 8 parms
m-equb &ff \ max parms
n)equb &00 \ flags
oCequd addtopath_syntax \ offset to invalid syntax message
p9equd addtopath_help \ offset to help message
r$equs "PrependToPath":dcb 0:align
s2equd prependpath_cmd \ offset to code
t-equb &02 \ min parms
uAequb &00 \ GSTrans map for first 8 parms
v-equb &ff \ max parms
w)equb &00 \ flags
xEequd prependpath_syntax \ offset to invalid syntax message
y;equd prependpath_help \ offset to help message
\ Help only entries
}%equs "CSD$Var":dcb 0:align:equd 0
~, equd &00000:equd 0:equd csdvarhelp
%equs "PWD$Var":dcb 0:align:equd 0
, equd &00000:equd 0:equd pwdvarhelp
,equs "DirectoryStack":dcb 0:align:equd 0
/ equd &00000:equd 0:equd dirstack_help
equd 0
1.ie_nf \ internal error, non fatal
stmfd r13!,{r1-r4,r14}
mov r3,r0
mov r4,r14
adr (0,ienfmh)
mov r1,#0
mov r2,#0
swi "XOS_PrettyPrint"
mov r0,r4
orr r0,r0,#1<<28
swi
my_swi("Debug1")
add r0,r3,#4
swi "XOS_PrettyPrint"
adr (0,ienfmt)
swi "XOS_PrettyPrint"
mov r0,r3
ldmfd r13!,{r1-r4,pc}^
.print_address
\ On entry, r0 = address
!\ On exit, all regs preserved
stmfd r13!,{r0-r2,r14}
mov r10,r0
ldr r12,[r12]
add r12,r12,#bufsize%
sub r12,r12,#16
bl printmode
swi 256+
mov r1,#%11
!orr r1,r1,#(%111111)<<26
bic r0,r0,r1
mov r1,r12
mov r2,#16
swi "XOS_ConvertHex8"
swivc 256+
swivc "XOS_Write0"
swi 256+
mov r0,r10
bl printflags
swi 256+32
ldmfd r13!,{r0-r2,pc}^
.printmode
stmfd r13!,{r0,r1,r14}
and r1,r0,#%11
adr r0,modes_base
;add r0,r0,r1,lsl#2 \ offset into table of words
(swi "XOS_Write0" \ display
ldmfd r13!,{r0,r1,pc}^
.modes_base
.\ user mode = %00 : dcb "USR":dcb 0
.\ fast interrupt = %01 : dcb "FIQ":dcb 0
.\ interrupt mode = %10 : dcb "IRQ":dcb 0
.\ supervisor mode = %11 : dcb "SVC":dcb 0
.flags_base
1\ Flags are: dcb "nzcvif":dcb 0
align
.printflags
stmfd r13!,{r0-r2,r14}
!and r1,r0,#(%111111)<<26
adr r2,flags_base
.pfloop
0ldrb r0,[r2],#1 \ get flag letter
&cmp r0,#0 \ done?
ldmeqfd r13!,{r0-r2,pc}^
0tst r1,#1<<31 \ is top bit set?
>moveq r0,#0 \ if not, replace flag with NULL
0swi "XOS_WriteC" \ print character
5mov r1,r1,lsl#1 \ shift onto next flag
b pfloop
.pwdhelp
Ddcb
osd("Prints the current directory's full path name."):dcb 0
.csdvarhelp
Jdcb
osd("The CSDVar module provides a magic system variable called ")
Kdcb
osd("'CSD$Var' that holds the pathname of the current directory.")
dcb 13:dcb 13
Ndcb
osd("Since this pathname can get quite long, the CSDVar module can ")
Pdcb
osd("chop a chunk out of the middle and replace it with an 'elipsis' ")
Odcb
osd("sequence (eg. '...') to make the path a more reasonable length.")
dcb 13:dcb 13
Kdcb
osd("You can set the (maximum) length and 'elipsis' sequence by ")
5dcb
osd("*set-ing the CSD$Var system variable:")
Idcb 13:dcb 9:dcb
osd("*Set CSD$Var <max_length> [<elipsis_string>]")
dcb 13:dcb 13
Sdcb
osd("Specifying a <max_length> of 0 means ""don't alter the max length""")
Qdcb
osd(". If the <elipsis_string> is omitted, then only the <max_length> ")
Ndcb
osd("parameter is considered (the <max_length> parameter *must* be ")
osd("supplied).")
dcb 13:dcb 13
Ldcb
osd("To include spaces in the 'elipsis' string, surround it with ")
0dcb
osd("double-quotation marks, ie. ""s.")
dcb 13:dcb 13
Ldcb
osd("Prefixing any part of the 'elipsis' string with a backslash ")
Sdcb
osd("character (ie. \) causes the next character to be taken literally, ")
,dcb
osd("eg. use \"" to include a "".")
dcb 13:dcb 13
Mdcb
osd("The minimum value of <max_len> is 10, and the maximum is 440.")
dcb 13:dcb 13
Sdcb
osd("Note that the <max_len> and 'elipsis' string *only* affect CSD$Var,")
8dcb
osd(" and have no effect on the *pwd command.")
dcb 13:dcb 13
osd("Suggested use:")
<dcb 13:dcb 9:dcb
osd("SetMacro CLI$Prompt <CSD$Var> *")
dcb 0
.pwdvarhelp
Ndcb
osd("PWD$Var is similar to CSD$Var except that it is never clipped ")
Odcb
osd("(and no elipsis is inserted). This can be useful as it allows ")
:dcb
osd("the CSD's full name to be examined."):dcb 13
Mdcb
osd("Eg. *Set This$Dir <PWD$Var>. Obviosuly CSD$Var is unsuitable ")
%dcb
osd("for this sort of use.")
dcb 0
.dirstack_help
Jdcb
osd("The directory stack features of CSDVar extend the concept ")
Mdcb
osd("of the OS *back command (the *Back command swaps between the ")
?dcb
osd("current (CSD) and previous directories)."):dcb 13
Odcb
osd("CSDVar allows you to 'push' directories onto a stack, and then ")
Edcb
osd("'pop' them off later. There is no limit on how many ")
Kdcb
osd("directories you can store in this way. CSDVar also allows ")
Ldcb
osd("you to remove any single directory, or all directories from ")
:dcb
osd("the stack without changing the CSD."):dcb 13
;dcb
osd("The commands that operate on the stack are:")
Rdcb 13:dcb p$+
osd("*PushDir "+t$+" pushes a directory onto the stack"):dcb 13
Ndcb p$+
osd("*PopDir "+t$+" pops the top directory from the stack"):dcb 13
Ndcb p$+
osd("*UnStackDir "+t$+" as *PopDir, but leaves the CSD unchanged")
Rdcb 13:dcb p$+
osd("*KillStack "+t$+" removes all directories from the stack")
Kdcb 13:dcb p$+
osd("*ListStack "+t$+" lists the contents of the stack")
dcb 0
.pushdir_help
Ndcb
osd("The *PushDir command stores the current directory name on the ")
Kdcb
osd("CSDVar stack. You can push as many directories as you like ")
+dcb
osd("(memory permitting)."):dcb 13
Sdcb
osd("To get the directories back off the stack, use *PopDir (qv.)"):dcb 13
Kdcb
osd("To remove directories from the stack, use *UnPushDir"):dcb 13
Kdcb
osd("To list the directories on the stack, use *ListStack"):dcb 13
.pushdir_syntax
5dcb
osd("Syntax: *PushDir [<directory>]"):dcb 13
Qdcb
osd("if <directory> is omitted, then the CSD (ie. @) is assumed."):dcb 0
.popdir_help
Odcb
osd("The *PopDir command retrieves the top entry from the directory ")
Odcb
osd("stack, and sets the CSD to this directory. The stack entry is ")
osd("removed."):dcb 13
.popdir_syntax
!%dcb
osd("Syntax: *PopDir"):dcb 0
.unpushdir_help
$Qdcb
osd("The *UnPushDir removes specified directory from the stack."):dcb 13
%Jdcb
osd("If the specified directory has been pushed more than once ")
&Adcb
osd("then only the most recent will be removed."):dcb 13
.unpushdir_syntax
(4dcb
osd("Syntax: *UnPushDir <directory>"):dcb 0
.liststack_help
+Jdcb
osd("The *ListStack command displays the directory stack, most ")
,Odcb
osd("recently pushed directory last. *ListStack also tells you how ")
-Ldcb
osd("many directories are stacked, and how much memory the stack ")
. dcb
osd("occupies."):dcb 13
.liststack_syntax
0(dcb
osd("Syntax: *ListStack"):dcb 0
.unstackall_help
3Mdcb
osd("The *KillStack command removes every directory from the stack")
4=dcb 31:dcb
osd("freeing all storage as it goes."):dcb 13
.unstackall_syntax
6(dcb
osd("Syntax: *KillStack"):dcb 0
.addtopath_help
9Odcb
osd("The *AddToPath command appends directories to a path variable, ")
:Qdcb
osd("but only if they are not already present in the path variable to ")
;Ndcb
osd("start with. The entries added to the path variable are *not* ")
<Ldcb
osd("GSTrans'd, or canonicalised in any way (but *AddToPath will ")
=Odcb
osd("take any such translations into account when checking the path ")
>3dcb
osd("variable for the directory)."):dcb 13
?Ndcb
osd("The new entries are appended to the path variable. To prepend ")
@@dcb
osd("the new entries, use *PrependToPath (qv.)"):dcb 13
.addtopath_syntax
BRdcb
osd("Syntax: *AddToPath <path variable> <directory> [ <directory> ... ]")
C dcb 0
.prependpath_help
FQdcb
osd("As *AddToPath (qv.) but prepends the new directories to the path ")
G<dcb
osd("variable, rather than appending them."):dcb 13
.prependpath_syntax
IQdcb
osd("Syntax: *PrependToPath <path variable> <directory> [ <directory> ")
osd("... ]")
K dcb 0
OD.eliptl_err equd 1:equs "'Elipsis' string too long":equb 0
P@.incompipe_err equd 1:equs "Incomplete \ sequence":equb 0
Q5.missingq_err equd 1:equs "Missing """:equb 0
RG.btsmlm equd 1:equs "Buffer too small to read CSD":equb 0
SI.nirma_eblk equd 1:equs "Head/Tail *must* be in the RMA":equb 0
TP.stack_what_stack equd 1:equs "Adny has fucked the stack up Real Bad
":dcb 0
UH.adnyfu equd 1:equs "Adny fucked up the ArgV thangs":dcb 0
W+.variablename equs "CSD$Var":equb 0
X+.variable2_name equs "PWD$Var":equb 0
Y+.defelips equs elipsis$:equb 13
Z%.pathname equs "@":equb 0
[*.stringpath equs "$path>":equb 0
\>.scnts equs
osd("Stack contains"):dcb 31:dcb 0
]=.entries dcb 31:equs
osd("directories ("):dcb 0
^G.liststackhead dcb 13:equs
osd("Directory stack:"):dcb 13:dcb 0
_C.bytesmess dcb 31:equs
osd("bytes used)."):dcb 13:dcb 0
`G.ienfmh dcb
osd("CSDVar internal error at"):dcb 31:dcb 0
aG.ienfmt dcb
osd(", attempting to continue"):dcb 13:dcb 0
"ok!"
SHOWREGS_USED
[OPT pass%:
showregs:]
'"Saving module to CSD ... ";
"OS_File",10,"CSDVar",&FFA,,code%,O%
"ok!"
'"Module is ";O%-code%;" bytes (";htos%-htcs%;" bytes saved using OS dict)"
H3(A%):=
"000"+
~A%,3)
osd(a$)
os_dict_tokenise(a$)
(pass%
htos%+=
(a$):htcs%+=
(.txt)
(.txt)